home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
m2menu.zip
/
MENU1.MOD
< prev
next >
Wrap
Text File
|
1990-03-22
|
4KB
|
162 lines
MODULE menu1; (* TopSpeed Modula-2 V 1.16 *)
FROM IO IMPORT WrChar, WrLn, WrStr, WrStrAdj;
FROM Str IMPORT Length;
FROM Window IMPORT Black, White, Clear, Close, DoubleFrame,
GotoXY, Open, WinDef, WinType;
IMPORT MenuIO, IO;
CONST
DescLen = 40; (* label length *)
Offset = 1;
NumMain = 10; (* total number of selections *)
bel = 7C;
esc = 33C;
F1 = 273C;
F2 = 274C;
F3 = 275C;
F4 = 276C;
F5 = 277C;
F6 = 300C;
F7 = 301C;
F8 = 302C;
F9 = 303C;
F10 = 304C;
TYPE
xType = RECORD
ch: CHAR;
desc: ARRAY [0..DescLen] OF CHAR;
END;
VAR
MainMenu : ARRAY [0..NumMain-1] OF xType;
sc, Xch : CHAR;
MenuWin : WinType;
(* make a self-centering, self-wrapping menu *)
PROCEDURE MakeMenu(xArr: ARRAY OF xType): CHAR;
CONST
ScrDepth = 25;
ScrWidth = 80;
VAR
width, depth, left, top, right, bottom : CARDINAL;
i, j, len, maxLength: CARDINAL;
getCH, result : CHAR;
WD, smWD : WinDef;
xWidth: INTEGER;
BEGIN
maxLength := Length(xArr[0].desc);
FOR j := 1 TO HIGH(xArr) DO
len := Length(xArr[j].desc);
IF len > maxLength THEN
maxLength := len
END(*IF*)
END;(*FOR*)
width := maxLength+3;
depth := HIGH(xArr)+2;
left := (ScrWidth-width) DIV 2;
right := left+width;
top := (ScrDepth-depth) DIV 3;
bottom := top+depth;
xWidth := -INTEGER(width);
WITH WD DO
X1 := left;
Y1 := top;
X2 := right;
Y2 := bottom;
Foreground := White;
Background := Black;
CursorOn := FALSE;
WrapOn := FALSE;
Hidden := FALSE;
FrameOn := TRUE;
FrameDef:= DoubleFrame;
FrameFore:= White;
FrameBack:= Black
END;(*WITH*)
MenuWin := Open(WD);
FOR i := 0 TO HIGH(xArr) DO
WITH xArr[i] DO
WrLn;
WrChar(' ');
WrStr(desc)
END(*WITH*)
END;(*FOR*)
LOOP
getCH := MenuIO.GetKey(sc);
CASE getCH OF
F1..F10 : result := xArr[ORD(sc)-59].ch; EXIT
| esc: result := esc; EXIT
ELSE
WrChar(bel);
END;(*CASE*)
END;(*LOOP*)
Close(MenuWin);
RETURN result;
END MakeMenu;
(* menu labels *)
PROCEDURE MenuLabel(VAR xArr: ARRAY OF xType);
BEGIN
xArr[0].ch := '1';
xArr[1].ch := '2';
xArr[2].ch := '3';
xArr[3].ch := '4';
xArr[4].ch := '5';
xArr[5].ch := '6';
xArr[6].ch := '7';
xArr[7].ch := '8';
xArr[8].ch := '9';
xArr[9].ch := '0';
xArr[0].desc := "F1...Item One";
xArr[1].desc := "F2...Item Two";
xArr[2].desc := "F3...Item Three";
xArr[3].desc := "F4...Item Four";
xArr[4].desc := "F5...Item Five";
xArr[5].desc := "F6...Item Six";
xArr[6].desc := "F7...Item Seven";
xArr[7].desc := "F8...Item Eight";
xArr[8].desc := "F9...Item Nine";
xArr[9].desc := "F10..Item Ten"
END MenuLabel;
(* execute selection *)
PROCEDURE MenuAction(VAR xArr: ARRAY OF xType);
BEGIN
CASE Xch OF
'0'..'9' : Clear;
WrStr("Selection ");
WrStr(xArr[ORD(sc)-59].desc);
WrStr(": Executed!");
WrLn;
WrLn;
MenuIO.ExecCmd('pause')
END;(*CASE*)
END MenuAction;
(* run program *)
BEGIN
MenuLabel(MainMenu); (* initialize *)
LOOP
Clear;
GotoXY(30,3);
WrStr("<Esc> key exits program");
GotoXY(20,18);
WrStr("Hit a function key to make your selection > ");
Xch := MakeMenu(MainMenu);
IF Xch = esc THEN EXIT END;
MenuAction(MainMenu) (* execute *)
END;(*LOOP*)
Clear
END menu1.